home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.01 Jan 87 / neon source / vScroll demo < prev   
Encoding:
Text File  |  1986-10-26  |  3.2 KB  |  145 lines  |  [TEXT/MACA]
  1. : ** ;
  2.  
  3. : actFW enable: menubar 
  4.         4 1 do i enable: filemen loop 
  5.         decimal initFont
  6. ;
  7.  
  8. 0 value part#
  9.  
  10. :CLASS vsBar <super object
  11.  
  12.     rect vsRect
  13.     var wPtr
  14.     Handle ctlHndl
  15.  
  16. \ initializes the scrollbar rectangle from the port rectangle
  17. :M PUTRECT:  ( wPtr -- )
  18.     put: wPtr
  19.     getRect: [ get: wPtr ]
  20.     2swap swap drop
  21.     3 pick 16 -
  22.     swap 2swap
  23.     put: vsRect
  24. ;M
  25.  
  26. \ instantiates vertical scrollbar in window, returning handle in ctlHndl
  27. :M NEW:  ( -- )
  28.     0                    \ room for ctlHandle returned        
  29.     get: wPtr +base        \ window pointer
  30.     abs: vsRect            \ scrollbar bounds rectangle
  31.     nullOSstr            \ null Str255
  32.     256 makeint            \ visible
  33.     0 makeint            \ value
  34.     0 makeint            \ min
  35.     0 makeint            \ max
  36.     16 makeint            \ procID for scrollbars
  37.     0                    \ refCon
  38.     call NewControl
  39.     put: ctlHndl
  40. ;M
  41.  
  42.  
  43. \ disposes of heap storage for the scrollbars
  44. :M KILL: ( -- ) get: ctlHndl  call DisposControl  ;M
  45.  
  46.  
  47. \ draws scrollbars on update events
  48. :M DRAW: ( -- ) get: wPtr  +base call DrawControls  ;M
  49.  
  50. \ hilites the given part number
  51. :M HILITE: { thePart -- } get: ctlHndl thePart makeint call HiliteControl ;M
  52.  
  53. :M PUTMIN:  ( min -- ) get: ctlHndl swap makeint call SetMinCtl  ;M
  54. :M GETMIN:  ( -- min ) word0  get: ctlHndl call GetMinCtl I->L ;M
  55.  
  56. :M PUTMAX:  ( max -- ) get: ctlHndl swap makeint call SetMaxCtl  ;M
  57. :M GETMAX:  ( -- max ) word0  get: ctlHndl call GetMaxCtl I->L ;M
  58.  
  59. :M PUTVAL:  ( val -- ) get: ctlHndl swap makeint call SetCtlVal  ;M
  60. :M GETVAL:  ( -- val ) word0  get: ctlHndl call GetCtlVal I->L ;M
  61.  
  62. \ tests to see which part got hit and returns 0 or partcode in part#
  63. :M TEST: ( -- ) word0  get: ctlHndl  where: fevent  G->L
  64.         call TestControl  I->L  -> part# ;M
  65.  
  66. \ tracks the mouse, executing part handler's default procedure while mousedown
  67. :M TRACK:  ( -- partNumber or 0 on mouse-up )
  68.     word0                \ space for INT result
  69.     get: ctlHndl
  70.     where: fevent G->L    \ mouse point in local coordinates
  71.     -1
  72.     call TrackControl
  73.     I->L
  74. ;M
  75.  
  76. ;CLASS
  77.  
  78. window     edWind
  79. vsBar    edBar
  80.  
  81. \ close activate draw content handlers
  82. : fix <[ 4 ]> 'cfas null actFW cr null actions: fwind
  83.     close: edWind cls ;
  84.  
  85. : ok? depth . depth 0 > if . then rdepth . mdepth . ;
  86.  
  87. \ define scrollbar handlers
  88. : showValue 100 50 gotoxy getVal: edBar . ;
  89. : PUp  getVal: edBar 5 - putVal: edBar showValue ;
  90. : PDn  getVal: edBar 5 + putVal: edBar showValue ;
  91. : LUp  getVal: edBar 1 - putVal: edBar showValue ;
  92. : LDn  getVal: edBar 1 + putVal: edBar showValue ;
  93. : doThumb track: edBar drop showValue ;
  94.  
  95. : doPart ( part# -- )
  96.     case 20 of LUp endof
  97.         21 of LDn endof
  98.         22 of PUp endof
  99.         23 of PDn endof
  100.         129 of doThumb endof
  101.         drop
  102.     endcase
  103. ;
  104.  
  105. : makeEd    false setDrag: EdWind
  106.     false setGrow: EdWind
  107.     2 241 510 340 put: tempRect
  108.     tempRect " ed" 0 true false new: EdWind
  109. ;
  110.  
  111. : drawAll    draw: EdBar ;
  112.  
  113. : contEd
  114.     test: EdBar
  115.     part#
  116.     if part# hilite: edBar
  117.         begin stilldown? while
  118.         part# doPart
  119.         repeat
  120.       0 hilite: edBar
  121.     then
  122. ;
  123.  
  124. : actF     become actFW cls ;
  125.  
  126. : actEd begin
  127.     next: fevent
  128.     if 2drop then
  129.     again
  130. ;
  131.  
  132. \ close activate draw content
  133. \ instantiate both windows & bar  and display bar
  134. : test makeEd
  135.     set: EdWind        -curs
  136.     addr: edWind    putRect: edBar    \ setup vsRect from owning window
  137.     new: edBar
  138.     0 putMin: edBar    100 putMax: edBar
  139.     0 putVal: edBar    draw: edBar
  140.     <[ 4 ]> 'cfas null actEd drawAll contEd actions: edWind
  141.     <[ 4 ]> 'cfas null actF null null actions: fWind 
  142. ;
  143.  
  144.     
  145.